home *** CD-ROM | disk | FTP | other *** search
/ Apple II Magazines (DO) / Softdisk Magazette Volume 2, No. 02 (1982-10)(Softdisk)(Side B).zip / Softdisk Magazette Volume 2, No. 02 (1982-10)(Softdisk)(Side B).do / PRINT ROUTINES 1000-1999.txt < prev    next >
Text File  |  1996-12-24  |  13KB  |  203 lines
  1.  
  2. 1000  REM   - PRINT SUBROUTINE LIBRARY, PUBLIC SERVICE LAB, NORTH CAROLINA STATE UNIVERSITY
  3. 1001  REM   - IN PASSING VARIABLES NOTE THE FOLLOWING CONVENTIONS:
  4. 1002  REM   V= VALUE; STRING$= STRING
  5. 1003  REM    ARRAY(V) AND STRING$(V) ARE ARRAYS  
  6. 1004  REM   N = NUMBER OF VALUES OR STRINGS
  7. 1005  REM   CW = COLUMN WIDTH OR COLUMN NUMBER
  8. 1006  REM   I,I$,J,J$ = WORK VARIABLES
  9. 1007  REM    NP = NUMBER OF PLACES DESIRED AFTER DECIMAL
  10. 1008  REM 
  11. 1009  REM   - JUSTIFICATION ROUTINES
  12. 1010 I$ = "": FOR I = 1 TO (CW -  LEN (STRING$)):I$ = I$ + " ": NEXT : PRINT  RIGHT$ (I$ + STRING$,CW): RETURN : REM      - RIGHT JUSTIFICATION ROUTINE FOR STRINGS   
  13. 1011  REM   IN LINE 1010 THE VALUE MUST START OUT AS A STRING FOR LEADING AND TRAILING ZEROS TO BE RETAINED; USE V=VAL(STRING$) TO CONVERT LATER FOR COMPUTATION PURPOSES  
  14. 1012  PRINT  SPC( CW -  LEN ( STR$ (V))); STR$ (V): RETURN : REM    RIGHT JUSTIFICATION ROUTINE FOR VARIABLES - LEADING AND TRAILING ZEROS GET DROPPED  
  15. 1014  REM    LINES 1014-1020 ARE A VARIABLE ARRAY RIGHT JUSTIFICATION ROUTINE  
  16. 1015  FOR I = 1 TO N:ARRAY$(I) =  STR$ (ARRAY(I))
  17. 1016  GOSUB 1017: PRINT  TAB( CW - J);ARRAY(I): NEXT : RETURN 
  18. 1017 J = 0
  19. 1018 J = J + 1: IF J =  LEN (ARRAY$(I)) AND  MID$ (ARRAY$(I),J,1) <  > "." THEN J = J + 1: GOTO 1020
  20. 1019  IF  MID$ (ARRAY$(I),J,1) <  > "." THEN 1018
  21. 1020  RETURN 
  22. 1030  REM  - ROUNDING TO A FRACTION
  23. 1031 VI =  INT (V):F = V - VI:F$ = "   "
  24. 1032  IF F > .0625 THEN F$ = "1/8": IF F > .1625 THEN F$ = "1/5": IF F > .225 THEN F$ = "1/4": IF F > .291666667 THEN F$ = "1/3": IF F > .354166667 THEN F$ = "3/8": IF F > .3875 THEN F$ = "2/5": IF F > .45 THEN F$ = "1/2": GOTO 1034
  25. 1033  GOTO 1035
  26. 1034  IF F > .55 THEN F$ = "3/5": IF F > .6125 THEN F$ = "5/8": IF F > .64583 THEN F$ = "2/3": IF F > .7083333 THEN F$ = "3/4": IF F > .775 THEN F$ = "4/5": IF F > .8375 THEN F$ = "7/8": IF F > .9375 THEN F$ = "":VI = VI + 1
  27. 1035 VI$ =  STR$ (VI): IF VI = 0 THEN VI$ = " "
  28. 1036 STRING$ = VI$ + " " + F$: RETURN : REM   END OF FRACTIONAL ROUNDING
  29. 1040  REM   - CORRECT ROUNDING; NP = NUMBER OF DECIMAL PLACES DESIRED; PASS V AND GET ROUNDED V BACK
  30. 1041 V =  INT (V * 10 ^ NP + .5) / 10 ^ NP: RETURN 
  31. 1049  REM 
  32. 1050  REM   - MONEY ROUTINES
  33. 1051  REM    LINES 1051-1060 CONTAIN A SUBROUTINE WHICH FORMATS VALUES AS DOLLARS AND CENTS, TRUNCATING EXTRA DECIMALS AND ADDING THE '$' - PASS V TO GOSUB 1052 AND GET STRING$ BACK
  34. 1052 I$ =  STR$ ( INT ((V + .0001) * 100)):I% =  LEN (I$):J$ = "$":I1$ = "":I2$ = ".":I3$ =  RIGHT$ (I$,2)
  35. 1053  ON I% GOTO 1054,1055,1059,1059,1059,1059,1059,1059,1059
  36. 1054 I3% = "0" + I3$: GOTO 1060
  37. 1055  IF  LEFT$ (I$,1) = "-" THEN 1057
  38. 1056  GOTO 1060
  39. 1057 I3$ = "0" +  RIGHT$ (I3$,1)
  40. 1058 I1$ = "-": GOTO 1060
  41. 1059 I1$ =  LEFT$ (I$,(I% - 2))
  42. 1060 STRING$ = J$ + I1$ + I2$ + I3$: RETURN 
  43. 1070  REM  ALTERNATIVE DOLLAR FORMATTER
  44. 1071 V =  INT (V * 100 + .5) / 100:STRING$ = "$" +  STR$ (V):J =  LEN (STRING$): IF J = 1 THEN 1075
  45. 1072  IF  MID$ (STRING$,J - 1,1) = "." THEN STRING$ = STRING$ + "0": GOTO 1076
  46. 1073  IF J < 3 THEN 1075
  47. 1074  IF  MID$ (STRING$,J - 2,1) = "." THEN 1076
  48. 1075 STRING$ = STRING$ + ".00"
  49. 1076  RETURN 
  50. 1099  REM 
  51. 1100  REM   - STRING FORMATTING ROUTINES
  52. 1101  REM 
  53. 1109  REM     -  LINES 1110 TO 1120 CONTAIN A SUBROUTINE  WHICH WILL FORMAT A LONG STRING (6 LINES) SO WORDS WILL NOT BE SPLIT INAPPROPRIATELY. AT PRESENT IT IS SET FOR DOUBLE-SPACING. TO SINGLE-SPACE REMOVE A PRINT STATEMENT FROM LINE 1117
  54. 1110 I = 1
  55. 1111  PRINT :J = 0
  56. 1112 I$ = ""
  57. 1113 J$ =  MID$ (STRING$,I,1):I = I + 1: IF I >  LEN (STRING$) GOTO 1119
  58. 1114  IF J$ <  > " " THEN I$ = I$ + J$: GOTO 1113
  59. 1115  IF J +  LEN (I$) = 40 THEN  PRINT I$;: GOTO 1111
  60. 1116  IF J +  LEN (I$) = 39 THEN  PRINT I$: GOTO 1111
  61. 1117 I$ = I$ + " ":J = J +  LEN (I$): IF J > 40 THEN  PRINT : PRINT :J =  LEN (I$)
  62. 1118  PRINT I$;: GOTO 1112
  63. 1119  IF J +  LEN (I$) > 40 THEN  PRINT : PRINT 
  64. 1120  PRINT I$; RIGHT$ (STRING$,1): RETURN 
  65. 1199  REM 
  66. 1200  REM   - SOUND ROUTINES
  67. 1201  REM 
  68. 1209  REM   - LINES 1210 - 1213 ARE A TYPEWRITER EFFECT WHICH ACCEPTS STRING$ AND PRINTS IT WITH CLICKS
  69. 1210  FOR I = 1 TO  LEN (STRING$): PRINT  MID$ (STRING$,I,1);
  70. 1211  IF  MID$ (STRING$,I,1) = " " THEN 1213
  71. 1212 J =  PEEK ( - 16336)
  72. 1213  FOR J = 1 TO 45: NEXT : NEXT : PRINT : RETURN : REM     TYPEWRITER EFFECT
  73. 1219  REM    LINES 1220 - 1223 ARE THE SAME THING, BUT "UNTYPEWRITING" A LINE, ERASING FROM THE RIGHT - STRING$ MAY BE 39 CHARACTERS MAX  - LESS IF NOT STARTED IN COLUMN 1
  74. 1220 :
  75. 1221  VTAB ( PEEK (37)): FOR I =  LEN (STRING$) TO 1 STEP  - 1: HTAB I: CALL  - 868: FOR J = 1 TO 60: NEXT : REM   - PEEK(37) IS MEMORY LOCATION OF CURSOR VERTICAL POSITION; CALL -868 CLEARS TO END OF LINE
  76. 1222 J =  PEEK ( - 16336): NEXT : POKE 37, PEEK (37) - 1: RETURN 
  77. 1229  REM   - LINES 1230-1234 CONTAIN A TYPEWRITER ROUTINE USING A MOVING CURSOR 
  78. 1230 CURSR$ = "+>": SPEED= 210
  79. 1231  FOR I = 1 TO  LEN (CURSR$):CURSR$ = CURSR$ +  CHR$ (8): NEXT 
  80. 1232  FOR I = 1 TO  LEN (STRING$): INVERSE : PRINT CURSR$;: NORMAL :I$ =  MID$ (STRING$,I,1): PRINT I$;: IF I$ = " " OR I$ = "." THEN  FOR J = 1 TO 25 + 150 * (I$ = "."): NEXT 
  81. 1233  IF I$ <  > " " THEN  FOR J = 1 TO 2:K =  PEEK ( - 16336): NEXT 
  82. 1234  NEXT : CALL  - 868: PRINT : SPEED= 255: RETURN 
  83. 1299  REM 
  84. 1300  REM   - TITLE ROUTINES
  85. 1301  REM 
  86. 1310 I =  INT ((40 -  LEN (STRING$)) / 2): PRINT  SPC( I);STRING$: RETURN : REM    -  TITLE CENTERING ROUTINE
  87. 1311 L =  PEEK (37):SP$ = "": FOR I = 1 TO 20 -  LEN (STRING$) / 2:SP$ = SP$ + " ": NEXT :STRING$ = SP$ + STRING$ + SP$: IF  LEN (STRING$) / 2 <  >  INT ( LEN (STRING$) / 2) THEN STRING$ = STRING$ + "": REM  - CENTERSPREAD TITLING - SET SOUND>=1 FOR SOUND
  88. 1312  IF  LEN (STRING$) / 2 <  >  INT ( LEN (STRING$) / 2) THEN STRING$ = STRING$ + " "
  89. 1313  FOR J = 1 TO 20:PR$ =  LEFT$ (STRING$,J) +  RIGHT$ (STRING$,J): VTAB L: HTAB 21 - J: IF SOUND THEN Q =  PEEK ( - 16336) +  PEEK ( - 16336)
  90. 1314  PRINT PR$: NEXT : RETURN : REM    CENTERSPREAD TITLING END; VTAB, THEN PASS STRING$ AND (IF DESIRED) SOUND=1 TO 1311
  91. 1315 I =  PEEK (37): FOR J = 1 TO 19 +  LEN (STRING$) / 2: VTAB I + 1: HTAB 40 - J: PRINT  LEFT$ (STRING$,J);" ";: FOR K = 1 TO 40: NEXT : NEXT : PRINT : RETURN : REM   - SLIDE TO CENTER
  92. 1316  HOME : FOR X = 5 TO 34 STEP .25: PRINT  TAB(  INT (12 + 11 *  SIN (X)));STRING$: NEXT : FOR D = 1 TO 3000: NEXT : RETURN : REM   - SINE WAVE TITLE
  93. 1319  REM    - LINES 1320 - 1348 ARE A MOVING WORDS TITLE ROUTINE WHICH ACCEPTS AN EIGHT-WORD (EXACTLY) ARRAY CALLED STRING$(I)
  94. 1320  VTAB 5: HTAB 6: PRINT STRING$(4);
  95. 1321  VTAB 5: HTAB 19: PRINT STRING$(5)
  96. 1322  VTAB 5: HTAB 29: PRINT STRING$(1)
  97. 1323  VTAB 12: HTAB 6: PRINT STRIMG$(3)
  98. 1324  VTAB 12: HTAB 29: PRINT STRING$(2)
  99. 1325  VTAB 23: HTAB 6: PRINT STRING$(6)
  100. 1326  VTAB 23: HTAB 19: PRINT STRING$(8)
  101. 1327  VTAB 23: HTAB 29: PRINT STRING$(7)
  102. 1328  HOME 
  103. 1329  FOR I = 1 TO 2: REM    - NUMBER OF LOOPS
  104. 1330  FOR J = 1 TO 22
  105. 1331  GOSUB 1338: NEXT 
  106. 1333  FOR J = 23 TO 1 STEP  - 1
  107. 1334  GOSUB 1338
  108. 1335  NEXT J
  109. 1336  NEXT I
  110. 1337  TEXT : RETURN 
  111. 1338  HOME 
  112. 1339  VTAB 12: HTAB J + 6: PRINT STRING$(4);
  113. 1340  HTAB 30 - J: PRINT STRING$(5)
  114. 1341  VTAB J + 1: HTAB J + 6: PRINT STRING$(1);
  115. 1342  HTAB 30 - J: PRINT STRING$(3);
  116. 1343  HTAB 18: PRINT STRING$(2);
  117. 1344  VTAB 24 - J: HTAB J + 6: PRINT STRING$(6);
  118. 1345  HTAB 30 - J: PRINT STRING$(8);
  119. 1346  HTAB 18: PRINT STRING$(7);
  120. 1347  FOR K = 1 TO 50: NEXT : REM    - SEED
  121. 1348  RETURN : REM   - END OF MOVING WORDS TITLE ROUTINE
  122. 1350  HOME :I$ = "": SPEED= 240: REM   - INVERSETITLE PATTERN
  123. 1351  FOR I = 1 TO 50:I$ = I$ + " ": INVERSE : PRINT " ";STRING$;" ";: NORMAL : PRINT I$;: NEXT : SPEED= 255: RETURN 
  124. 1360  REM  - FALLING LEAVES TITLE
  125. 1361 L =  PEEK (37): IF  NOT QQ THEN  DIM R$(40),DL(40):QQ = 1
  126. 1362  POKE 216,0: FOR X = 0 TO 39:R$(X) = " ":DL(X) = 0: NEXT : FOR X = 1 TO  LEN (STRING$):R$(X) =  MID$ (STRING$,X,1): NEXT : FOR X = 0 TO  LEN (STRING$) - 1:DL(X) =  INT (( RND (1) * L) - L): NEXT 
  127. 1363  FOR X = 0 TO  LEN (STRING$):DL(X) = DL(X) + 1: IF DL(X) > L THEN DL(X) = L
  128. 1364  IF DL(X) = 0 THEN DL(X) = 1
  129. 1365  IF DL(X) < 1 THEN 1368
  130. 1366  HTAB (X +  INT ((20 -  LEN (STRING$) / 2))): VTAB DL(X): PRINT R$(X): IF DL(X) = 1 THEN 1368
  131. 1367  HTAB (X +  INT ((20 -  LEN (STRING$) / 2))): VTAB DL(X) - 1: PRINT " "
  132. 1368  NEXT 
  133. 1369  FOR X = 0 TO  LEN (STRING$) - 1: IF DL(X) <  > L THEN 1363
  134. 1370  NEXT : RETURN : REM  END OF FALLING LEAVES TITLES
  135. 1399  REM 
  136. 1400  REM   - ERASE ROUTINES
  137. 1401  CALL  - 958: RETURN : REM   - CLEARS FROM CURSOR TO END/BOTTOM OF TEXT WINDOW
  138. 1402  CALL  - 868: RETURN : REM    - CLEARS FROM CURSOR TO END OF LINE (GIVEN TEXT WINDOW)
  139. 1403  CALL  - 875: RETURN : REM   - CLEAR ENTIRE TEXT LINE
  140. 1404  FOR I = 1 TO V: CALL  - 912: NEXT : REM   - SCROLL UP V LINES 
  141. 1409  REM    ERASE 39-CHARACTER LINE OR LESS FROM RIGHT TO LEFT VIA ROUTINE IN LINE 1410
  142. 1410  VTAB ( PEEK (37)): FOR I =  LEN (STRING$) TO 1 STEP  - 1: HTAB I: CALL  - 868: FOR J = 1 TO 60: NEXT : NEXT : POKE 37, PEEK (37) - 1: RETURN : REM      -  PEEK(37) IS MEMORY LOCATION OF CURSOR VERTICAL POSITION; CALL -868 CLEARS TO EN
  143. 1419  REM   - ERASE 40-CHARACTER LINE 0R LESS FROM LEFT TO RIGHT IN LINE 1420 
  144. 1420  VTAB ( PEEK (37)): FOR I = 2 TO 40: POKE 33,I: CALL  - 868: FOR J = 1 TO 60: NEXT : NEXT : POKE 37, PEEK (37) - 1: RETURN : REM    - POKE 33 SETS TEXT WINDOW WIDTH; CALL -868 CLEARS TO END OF LINE (GIVEN WINDOW); POKE 37 RESETS CURSOR
  145. 1421  REM  ***** PAGE WIPES
  146. 1422 X =  INT ( RND (1) * 9) + 1: ON X GOSUB 1423,1424,1425,1427,1430,1432,1434,1436,1440: RETURN : REM   - RANDOM WIPES
  147. 1423  FOR I = 1 TO 20: POKE 32,20 - I: POKE 33,2 * I: HOME : NEXT : RETURN : REM   CENTER OUT WIPE
  148. 1424  FOR I = 1 TO 12: POKE 34,12 - I: POKE 35,12 + I: POKE 33,4 + 3 * I: POKE 32,24 - 2 * I: CALL  - 936: FOR J = 1 TO 18: NEXT : NEXT : RETURN : REM   - EXPANDING BOX WIPE
  149. 1425  FOR I = 1 TO 24: VTAB 24: PRINT : NEXT : HOME : RETURN : REM    - SCROLL UP AND OUT WIPE
  150. 1427  INVERSE : FOR I = 24 TO 1 STEP  - 1: VTAB I: FOR J = I -  INT (I / 2) * 2 + 1 TO 40 STEP 2: HTAB J: PRINT " ";: NEXT : NEXT : NORMAL : HOME : RETURN : REM   CHECKERBOARD WIPE
  151. 1430  FOR I = 38 TO 0 STEP  - 1: POKE 32,I: POKE 33,40 - I: HOME : FOR D = 1 TO 40: NEXT : NEXT : RETURN : REM     -  LEFT-TO-RIGHT WHOLE-SCREEN WIPE  
  152. 1432  FOR I = 2 TO 40: POKE 33,I: HOME : FOR D = 1 TO 40: NEXT : NEXT : RETURN : REM    -  RIGHT-TO-LEFT WHOLE-SCREEN WIPE
  153. 1434  FOR I = 1 TO 24: POKE 35,I: HOME : FOR D = 1 TO 90: NEXT : NEXT : RETURN : REM      -   TOP-TO-BOTTOM WHOLE-SCREEN WIPE
  154. 1436  FOR I = 23 TO 0 STEP  - 1: POKE 34,I: HOME : FOR D = 1 TO 60: NEXT : NEXT : RETURN : REM    -  BOTTOM-TO-TOP WHOLE-SCREEN WIPE
  155. 1440  REM  - BEAGLE BROTHERS' HANDY-WIPE SCREEN ERASE
  156. 1441 LO = 1:HI = 24:S = LO
  157. 1442  FOR J = 1 TO 2: FOR I = LO TO HI STEP S
  158. 1443  INVERSE : VTAB I: PRINT  SPC( 40): NORMAL 
  159. 1444  VTAB I: CALL  - 868: NEXT 
  160. 1445 X = LO:LO = HI:HI = X:S = S *  - 1: NEXT : RETURN 
  161. 1500  REM   - SPECIAL EFFECTS
  162. 1509  REM     -  SCROLL HEADLINES UP TO 255 CHARACTERS VIA LINE 1510
  163. 1510 I =  PEEK (37):I$ = "                                        ":STRING$ = I$ + STRING$ + I$: FOR J = 1 TO  LEN (STRING$) - 40: VTAB I: PRINT  MID$ (STRING$,J,40);
  164. 1511  FOR K = 1 TO 90: NEXT : NEXT : PRINT : RETURN 
  165. 1512  HOME : VTAB 3: PRINT STRING$:L =  LEN (STRING$): REM   BANNER DROP AND SCROLL - LINES 1512-1518
  166. 1513  FOR I = 3 TO 12: VTAB I - 1: CALL  - 868: VTAB I: PRINT STRING$: FOR J = 1 TO 99: NEXT : NEXT 
  167. 1514  IF L < 40 THEN  FOR I = L + 1 TO 40:STRING$ = STRING$ + " ": NEXT 
  168. 1515 P = P + 1: IF P > 40 THEN P = 1:J = J + 1
  169. 1516  VTAB 12: HTAB 1: PRINT  RIGHT$ (STRING$,41 - P);: IF P > 1 THEN  PRINT  LEFT$ (STRING$,P - 1)
  170. 1517  FOR I = 1 TO 50: NEXT : IF J < 102 THEN 1515
  171. 1518  RETURN 
  172. 1520 I =  LEN (STRING$): VTAB  PEEK (37) + 1: FOR J = I TO 1 STEP  - 1: HTAB J: PRINT  MID$ (STRING$,J);: FOR D = 1 TO 90: NEXT : NEXT : RETURN : REM    - REVERSE PRINTING  -  39-CHARACTER STRING MA
  173. 1529  REM     - LINES 1530-34 CONTAIN A TYPING VERTICAL ROUTINE - PASS STRING$ AND CW (COLUMN NUMBER)
  174. 1530  HOME : POKE 32,CW: POKE 33,1: PRINT "  "
  175. 1531  FOR I = 1 TO  LEN (STRING$)
  176. 1532  PRINT  MID$ (STRING$,I,1): REM   - ADD SEMI-COLON HERE FOR SINGLE SPACING OF LETTERS
  177. 1533 J =  PEEK ( - 16336):J =  PEEK ( - 16336)
  178. 1534  FOR D = 1 TO 200: NEXT : NEXT : TEXT : RETURN : REM      - TYPING VERTICAL
  179. 1540  REM  
  180.  
  181. DOUBLE BATON ROUTINE        ADAPTED FROM BEAGLE         BROS. TIP BOOK NO. 4.
  182.  
  183.  
  184. 1541 CURSR$ = "!/-\":H = 1:C = H: POKE  - 16368,0
  185. 1542  VTAB 22: HTAB 8: PRINT STRING$
  186. 1543  VTAB 21: HTAB H: PRINT " "; MID$ (CURSR$,C,1);" ";: FOR I = 1 TO 33: NEXT 
  187. 1544  VTAB 23: HTAB 40 - H: PRINT " "; MID$ (CURSR$,C,1);" ";
  188. 1545 KEY =  PEEK ( - 16384): IF KEY > 31 THEN  RETURN 
  189. 1546 C = C + 1 - 4 * (C = 4):H = H + 1: IF H > 39 THEN H = 1: VTAB 21: HTAB 40: PRINT " ";: VTAB 23: HTAB 2: PRINT " ";
  190. 1547  GOTO 1543: REM   END OF BATON ROUTINE
  191. 1550 CURS$ = "!/-\":C = 1:Q$ =  CHR$ (34):L =  LEN (CURS$): SPEED= 177
  192. 1551  VTAB 24: PRINT "! ";STRING$;
  193. 1552  VTAB 24: HTAB 1: PRINT  MID$ (CURS$,C,1);
  194. 1553 KEY =  PEEK ( - 16384): IF KEY < 128 THEN C = C + 1 - L * (C = L): GOTO 1552
  195. 1554  POKE  - 16368,0: SPEED= 255: HOME : RETURN 
  196. 1555  HOME :W = W + 1: VTAB 10: HTAB 1 + (W -  INT (W / 2) * 2 = 0): PRINT  SPC( 1);"ANALYZING..."; SPC( 1)
  197. 1556  FOR I = 1 TO 250: NEXT : IF W < 10 THEN 1555
  198. 1557  RETURN : REM   - SUBROUTINE DURING ANALYZING
  199. 1600  REM 
  200. 1601  REM   UTILITIES
  201. 1602  REM 
  202. 1610 SEC = SEC + 2 * (SEC = 0): FOR I = 1 TO SEC * 980: NEXT : RETURN : REM  - PASS SEC=X FOR DELAY LOOP OF X SECONDS; DEFAULT IS 2-SECOND DELAY
  203.